home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Developer Essentials / DTS Sample Code / Macintosh Sample Code / SC.013.OOPTESample / UApplication.inc1.p < prev    next >
Encoding:
Text File  |  1989-09-30  |  13.5 KB  |  536 lines  |  [TEXT/MPS ]
  1. {---------------------------------------------------------------------
  2. #
  3. #    Apple Macintosh Developer Technical Support
  4. #
  5. #    MultiFinder-Aware Simple TextEdit Sample Application
  6. #
  7. #    OOPTESample
  8. #
  9. #    UApplication.inc1.p        -    Pascal Source
  10. #
  11. #    Copyright © 1988, 1989 Apple Computer, Inc.
  12. #    All rights reserved.
  13. #
  14. #    Version:        
  15. #                    1.10                    10/89
  16. #                    1.00                    04/89
  17. #
  18. #    Components:     
  19. #                    BuildOOPTESample        October 1, 1989
  20. #                    MOOPTESample.p            October 1, 1989
  21. #                    OOPTESample.make        October 1, 1989
  22. #                    TECommon.h                October 1, 1989
  23. #                    TESampleGlue.a            October 1, 1989
  24. #                    TESample.r                October 1, 1989
  25. #                    UApplication.p            October 1, 1989
  26. #                    UApplication.inc1.p        October 1, 1989
  27. #                    UDocument.p                October 1, 1989
  28. #                    UDocument.inc1.p        October 1, 1989
  29. #                    UTEDocument.p            October 1, 1989
  30. #                    UTEDocument.inc1.p        October 1, 1989
  31. #                    UTESample.p                October 1, 1989
  32. #                    UTESample.inc1.p        October 1, 1989
  33. #
  34. ---------------------------------------------------------------------}
  35.  
  36. CONST
  37.     kOSEvent                = app4Evt;    { Event used by MultiFinder }
  38.     kSuspendResumeMessage    = $01;        { high byte of suspend/resume event message }
  39.     kClipConvertMask        = $02;        { bit of message field clip conversion }
  40.     kResumeMask                = $01;        { bit of message field for resume vs. suspend }
  41.     kMouseMovedMessage        = $FA;        { high byte of mouse-moved event message }
  42.     
  43.     kErrStrings                = 128;
  44.     rUserAlert                = 129;
  45.     
  46.     eWrongMachine            = 1;
  47.     eSmallSize                = 2;
  48.  
  49.  
  50. (********************************************************************************************)
  51. (*        U t i l i t y   r o u t i n e s                                                        *)
  52. (********************************************************************************************)
  53.  
  54. {This routine is part of the MPW runtime library. This external
  55.  reference to it is done so that we can unload its segment, %A5Init.}
  56.  
  57. PROCEDURE _DataInit;
  58.     EXTERNAL;
  59.  
  60. {$S Main}
  61. {-----------------------------------+
  62. |    AlertUser                        |
  63. +-----------------------------------}
  64. { Display alert, using specified error STR# resource and error code as index }
  65. PROCEDURE AlertUser(errResID:integer; errCode:integer);
  66. VAR
  67.     message: Str255;
  68.     dummy: integer;
  69. BEGIN
  70.     SetCursor(arrow);
  71.     GetIndString(message, errResID, errCode);
  72.     ParamText(message, '', '', '');
  73.     dummy := Alert(rUserAlert, NIL);
  74. END;
  75.  
  76. {$S Main}
  77. {-----------------------------------+
  78. |    BigBadError                        |
  79. +-----------------------------------}
  80. { call AlertUser to display error message, then quit... }
  81. PROCEDURE BigBadError(errResID:integer; errCode: integer);
  82. BEGIN
  83.     AlertUser(errResID,errCode);
  84.     ExitToShell;
  85. END;
  86.  
  87. {$S Initialize}
  88. PROCEDURE InitSeg;
  89. BEGIN
  90. END;
  91.  
  92. (********************************************************************************************)
  93. (*        T A p p l i c a t i o n                                                                *)
  94. (********************************************************************************************)
  95. {$S Initialize}
  96. {-----------------------------------+
  97. |    IApplication                    |
  98. +-----------------------------------}
  99. PROCEDURE TApplication.IApplication;
  100.  
  101. VAR
  102.     envRec: sysEnvRec;
  103.     stkNeeded, heapSize: longint;
  104.     dummy: OSErr;
  105.  
  106. BEGIN
  107.     { initialize Mac Toolbox components }
  108.     InitGraf(@thePort);
  109.     InitFonts;
  110.     InitWindows;
  111.     InitMenus;
  112.     TEInit;
  113.     InitDialogs(NIL);
  114.     InitCursor;
  115.  
  116.     { Unload data segment: note that _DataInit must not be in Main! }
  117.     UnloadSeg(@_DataInit);
  118.  
  119.     { Ignore the error returned from SysEnvirons; even if an error occurred, }
  120.     { the SysEnvirons glue will fill in the SysEnvRec }
  121.     dummy := SysEnvirons(curSysEnvVers, envRec);
  122.  
  123.     { Are we running on a 128K ROM machine or better??? }
  124.     IF (envRec.machineType < 0) THEN
  125.       BigBadError(kErrStrings,eWrongMachine);        { if not, alert & quit }
  126.  
  127.     { if we need more stack space, get it now }
  128.     stkNeeded := StackNeeded;
  129.     IF (stkNeeded > StackSpace) THEN BEGIN
  130.         { new address is heap size + current stack - needed stack }
  131.         SetApplLimit(Ptr((longint(GetApplLimit) - stkNeeded + StackSpace)));
  132.     END;
  133.     
  134.     { Check for minimum heap size }
  135.     heapSize := longint(GetApplLimit) - longint(ApplicZone);
  136.     IF (heapSize < HeapNeeded) THEN
  137.       BigBadError(kErrStrings,eSmallSize);
  138.  
  139.     { expand the heap so new code segments load at the top }
  140.     MaxApplZone;
  141.  
  142.     { allocate an empty document list }
  143.     NEW(fDocList);
  144.     fDocList.IDocumentList;
  145.  
  146.     { check to see if WaitNextEvent is implemented }
  147.     fHaveWaitNextEvent := TrapAvailable(_WaitNextEvent, ToolTrap);
  148.  
  149.     { initialize our class variables }
  150.     fCurDoc := NIL;
  151.     fDone := FALSE;
  152.     fInBackground := FALSE;
  153.     fMouseRgn := NIL;
  154.     fWhichWindow := NIL;
  155. END;
  156.  
  157. {$S Main}
  158. {-----------------------------------+
  159. |    EventLoop                        |
  160. +-----------------------------------}
  161. PROCEDURE TApplication.EventLoop;
  162. VAR
  163.     gotEvent: Boolean;
  164.     anEvent: EventRecord;
  165. BEGIN
  166.  
  167.     SetUp;        { call setup routine }
  168.     DoIdle;        { do idle once }
  169.  
  170.     WHILE (fDone = FALSE) DO BEGIN
  171.  
  172.         { always set up fWhichWindow before doing anything }
  173.         fWhichWindow := FrontWindow;
  174.         IF (fWhichWindow <> nil) then begin
  175.             { see if window belongs to a document }
  176.             fCurDoc := fDocList.FindDoc(fWhichWindow);
  177.             { make sure we always draw into correct window }
  178.             SetPort(fWhichWindow);
  179.         END ELSE BEGIN
  180.             fCurDoc := nil;
  181.         END;
  182.  
  183.  
  184.         DoIdle;            { call idle time handler }
  185.  
  186.         IF (fHaveWaitNextEvent) THEN BEGIN
  187.             gotEvent := WaitNextEvent(everyEvent, anEvent, SleepVal, fMouseRgn);
  188.         END ELSE BEGIN
  189.             SystemTask;
  190.             gotEvent := GetNextEvent(everyEvent, anEvent);
  191.         END;
  192.         fTheEvent := anEvent;
  193.  
  194.         { make sure we got a real event }
  195.         IF gotEvent THEN BEGIN
  196.             AdjustCursor;
  197.             CASE (fTheEvent.what) OF
  198.                 mouseDown    : HdlMouseDown;
  199.                 mouseUp        : HdlMouseUp;
  200.                 keyDown,
  201.                 autoKey        : HdlKeyDown;
  202.                 updateEvt    : HdlUpdateEvt;
  203.                 diskEvt        : HdlDiskEvt;
  204.                 activateEvt    : HdlActivateEvt;
  205.                 kOsEvent     : HdlOSEvent;
  206.             END; { end switch (fTheEvent.what) }
  207.         END; { if gotEvent }
  208.         AdjustCursor;
  209.     END; {of EventLoop}
  210.     CleanUp;
  211. END;
  212.  
  213. {$S Main}
  214. {-----------------------------------+
  215. |    Setup                            |
  216. +-----------------------------------}
  217. PROCEDURE TApplication.Setup;        { Run before event loop starts }
  218. BEGIN
  219. END;
  220.  
  221. {$S Main}
  222. {-----------------------------------+
  223. |    CleanUp                            |
  224. +-----------------------------------}
  225. PROCEDURE TApplication.CleanUp;        { Run at end of loop }
  226. BEGIN
  227.     UnloadSeg(@InitSeg);
  228. END;
  229.  
  230. {$S Main}
  231. {-----------------------------------+
  232. |    ExitLoop                        |
  233. +-----------------------------------}
  234. PROCEDURE TApplication.ExitLoop;    { Call this to exit loop }
  235. BEGIN
  236.     fDone := TRUE;
  237. END;
  238.  
  239. {$S Main}
  240. {-----------------------------------+
  241. |    DoIdle                            |
  242. +-----------------------------------}
  243. PROCEDURE TApplication.DoIdle;        { Idle time handler (blink caret, background tasks) }
  244. BEGIN
  245. END;
  246.  
  247. {$S Main}
  248. {-----------------------------------+
  249. |    AdjustMenus                        |
  250. +-----------------------------------}
  251. PROCEDURE TApplication.AdjustMenus;    { Menu Updater routine }
  252. BEGIN
  253. END;
  254.  
  255. {$S Main}
  256. {-----------------------------------+
  257. |    HdlOSEvent                        |
  258. +-----------------------------------}
  259. PROCEDURE TApplication.HdlOSEvent;        { Calls DoSuspend, DoResume and DoIdle as apropos }
  260. VAR
  261.     doConvert: Boolean;
  262.     evType: byte;
  263. BEGIN
  264.  
  265.     { is it a multifinder event? }
  266.     evType := BAnd(BRotR(fTheEvent.message, 24),$00FF);
  267.     CASE evType OF        { high byte of message is type of event }
  268.         kMouseMovedMessage :
  269.             DoIdle;                    { mouse-moved is also an idle event }
  270.         kSuspendResumeMessage : BEGIN
  271.             doConvert := (BAnd(fTheEvent.message, kClipConvertMask) <> 0);
  272.             fInBackground := (BAnd(fTheEvent.message, kResumeMask) = 0);
  273.             IF (fInBackground) THEN
  274.                 DoSuspend(doConvert)
  275.             ELSE
  276.                 DoResume(doConvert);
  277.         END; { kSuspendResumeMessage }
  278.     END; { CASE Statement }
  279. END;
  280.  
  281. {$S Main}
  282. {-----------------------------------+
  283. |    HdlMouseDown                    |
  284. +-----------------------------------}
  285. PROCEDURE TApplication.HdlMouseDown;    { Calls DoContent, DoGrow, DoZoom, etc }
  286. VAR
  287.     mResult: Longint;
  288.     partCode: integer;
  289.     anEvent: EventRecord;
  290.     aWindow: WindowPtr;
  291. BEGIN
  292.     partCode := FindWindow(fTheEvent.where, aWindow);
  293.     fWhichWindow := aWindow;
  294.     CASE partCode OF
  295.         inSysWindow : MouseInSysWindow;
  296.         inMenuBar : BEGIN
  297.             AdjustMenus;
  298.             mResult := MenuSelect(fTheEvent.where);
  299.             IF (mResult <> 0) THEN
  300.               DoMenuCommand(HiWrd(mResult),LoWrd(mResult));
  301.         END;
  302.         inGoAway :
  303.             DoGoAway;
  304.         inDrag :
  305.             DoDrag;
  306.         inGrow :
  307.             IF (fCurDoc <> NIL) THEN BEGIN
  308.                 anEvent := fTheEvent;
  309.                 fCurDoc.DoGrow(anEvent);
  310.             END;
  311.         inZoomIn,
  312.         inZoomOut :
  313.             IF ((TrackBox(fWhichWindow, fTheEvent.where, partCode)) AND
  314.                     (fCurDoc <> NIL)) THEN
  315.                   fCurDoc.DoZoom(partCode);
  316.         inContent : { If window is not in front, make it so }
  317.             IF (fWhichWindow <> FrontWindow) THEN
  318.                 SelectWindow(fWhichWindow)
  319.             ELSE IF (fCurDoc <> NIL) THEN BEGIN
  320.                 anEvent := fTheEvent;
  321.                 fCurDoc.DoContent(anEvent);
  322.             END;
  323.     END;
  324. END;
  325.  
  326. {$S Main}
  327. {-----------------------------------+
  328. |    HdlKeyDown                        |
  329. +-----------------------------------}
  330. PROCEDURE TApplication.HdlKeyDown;        { also called for autokey events }
  331. VAR
  332.     key: char;
  333.     mResult: longint;
  334.     anEvent: EventRecord;
  335. BEGIN
  336.     key := char(BAnd(fTheEvent.message, charCodeMask));
  337.     IF ((BAnd(fTheEvent.modifiers, cmdKey) <> 0) AND (fTheEvent.what = keyDown)) THEN BEGIN
  338.         { only do command keys if we are not autokeying }
  339.         AdjustMenus;                    { make sure menus are up to date }
  340.         mResult := MenuKey(key);
  341.         IF (mResult <> 0) THEN BEGIN    { if it wasn't a menu key, pass it through }
  342.             DoMenuCommand(HiWrd(mResult), LoWrd(mResult));
  343.         END;
  344.     END ELSE BEGIN
  345.         IF (fCurDoc <> nil) THEN BEGIN
  346.             anEvent := fTheEvent;
  347.           fCurDoc.DoKeyDown(anEvent);
  348.         END;
  349.     END;
  350. END;
  351.  
  352. {$S Main}
  353. {-----------------------------------+
  354. |    HdlActivateEvt                    |
  355. +-----------------------------------}
  356. PROCEDURE TApplication.HdlActivateEvt;    { handles setup, and calls DoActivate (below) }
  357. BEGIN
  358.     { event record contains window ptr }
  359.     fWhichWindow := WindowPtr(fTheEvent.message);
  360.  
  361.     { see if window belongs to a document }
  362.     fCurDoc := fDocList.FindDoc(fWhichWindow);
  363.     SetPort(fWhichWindow);
  364.  
  365.     IF (fCurDoc <> NIL) THEN BEGIN
  366.         fCurDoc.DoActivate(BAnd(fTheEvent.modifiers, activeFlag) <> 0);
  367.     END;
  368. END;
  369.  
  370. {$S Main}
  371. {-----------------------------------+
  372. |    HdlUpdateEvt                    |
  373. +-----------------------------------}
  374. PROCEDURE TApplication.HdlUpdateEvt;    { handles setup, and calls DoUpdate (below) }
  375. BEGIN
  376.     { event record contains window ptr }
  377.     fWhichWindow := WindowPtr(fTheEvent.message);
  378.  
  379.     { see if window belongs to a document }
  380.     fCurDoc := fDocList.FindDoc(fWhichWindow);
  381.     SetPort(fWhichWindow);
  382.  
  383.     IF (fCurDoc <> NIL) THEN BEGIN
  384.         fCurDoc.DoUpdate;
  385.     END;
  386. END;
  387.  
  388. {$S Main}
  389. {-----------------------------------+
  390. |    HdlMouseUp                        |
  391. +-----------------------------------}
  392. PROCEDURE TApplication.HdlMouseUp;
  393. BEGIN
  394. END;
  395.  
  396. {$S Main}
  397. {-----------------------------------+
  398. |    HdlDiskEvt                        |
  399. +-----------------------------------}
  400. PROCEDURE TApplication.HdlDiskEvt;
  401. BEGIN
  402. END;
  403.  
  404. {$S Main}
  405. {-----------------------------------+
  406. |    MouseInSysWindow                |
  407. +-----------------------------------}
  408. PROCEDURE TApplication.MouseInSysWindow;
  409. VAR
  410.     anEvent: EventRecord;
  411. BEGIN
  412.     anEvent := fTheEvent;
  413.     SystemClick(anEvent,fWhichWindow);
  414. END;
  415.  
  416. {$S Main}
  417. {-----------------------------------+
  418. |    DoDrag                            |
  419. +-----------------------------------}
  420. PROCEDURE TApplication.DoDrag;
  421. BEGIN
  422.     DragWindow(fWhichWindow, fTheEvent.where, screenBits.bounds);
  423. END;
  424.  
  425. {$S Main}
  426. {-----------------------------------+
  427. |    DoGoAway                        |
  428. +-----------------------------------}
  429. PROCEDURE TApplication.DoGoAway;
  430. VAR
  431.     aWindow: WindowPeek;
  432. BEGIN
  433.     IF (TrackGoAway(fWhichWindow, fTheEvent.where)) THEN BEGIN
  434.         IF (fCurDoc <> NIL) THEN BEGIN
  435.             fDocList.RemoveDoc(fCurDoc);
  436.             fCurDoc.Free;    {TDocument.Free disposes of window}
  437.         END ELSE BEGIN
  438.             aWindow := WindowPeek(fWhichWindow);
  439.             CloseDeskAcc(aWindow^.windowKind);
  440.         END;
  441.         
  442.         { make sure our current document/window references are valid }
  443.         fWhichWindow := FrontWindow;
  444.         IF (fWhichWindow <> NIL) THEN BEGIN
  445.             fCurDoc := fDocList.FindDoc(fWhichWindow);
  446.             SetPort(fWhichWindow);
  447.         END ELSE
  448.             fCurDoc := NIL;
  449.  
  450.     END;
  451. END;
  452.  
  453. {$S Main}
  454. {-----------------------------------+
  455. |    AdjustCursor                    |
  456. +-----------------------------------}
  457. PROCEDURE TApplication.AdjustCursor;    { cursor adjust routine, should setup mouseRgn }
  458. BEGIN
  459. END;
  460.  
  461. {$S Main}
  462. {-----------------------------------+
  463. |    DoMenuCommand                    |
  464. +-----------------------------------}
  465. PROCEDURE TApplication.DoMenuCommand(menuID,menuItem: integer);
  466. BEGIN
  467. END;
  468.  
  469. {$S Main}
  470. {-----------------------------------+
  471. |    DoSuspend                        |
  472. +-----------------------------------}
  473. PROCEDURE TApplication.DoSuspend(VAR doClipConvert:Boolean);
  474. BEGIN
  475.     doClipConvert := FALSE;
  476.     IF (fCurDoc <> NIL) THEN
  477.       fCurDoc.DoActivate(NOT (fInBackground));
  478. END;
  479.  
  480. {$S Main}
  481. {-----------------------------------+
  482. |    DoResume                        |
  483. +-----------------------------------}
  484. PROCEDURE TApplication.DoResume(VAR doClipConvert:Boolean);
  485. BEGIN
  486.     doClipConvert := FALSE;
  487.     IF (fCurDoc <> NIL) THEN
  488.       fCurDoc.DoActivate(NOT(fInBackground));
  489. END;
  490.  
  491. {$S Initialize}
  492. {-----------------------------------+
  493. |    TrapAvailable                    |
  494. +-----------------------------------}
  495. FUNCTION TApplication.TrapAvailable(tNumber:integer;tType:TrapType):Boolean;
  496. BEGIN
  497.     { See if the trap exists. On 64K ROM machines, tType will be ignored. }
  498.     TrapAvailable := NGetTrapAddress(tNumber, tType) <>
  499.                         GetTrapAddress(_Unimplemented);
  500. END;
  501.  
  502. {$S Main}
  503. {-----------------------------------+
  504. |    DocList                            |
  505. +-----------------------------------}
  506. FUNCTION TApplication.DocList:TDocumentList;
  507. BEGIN
  508.     DocList := fDocList;
  509. END;
  510.  
  511. {$S Initialize}
  512. {-----------------------------------+
  513. |    StackNeeded                        |
  514. +-----------------------------------}
  515. FUNCTION TApplication.StackNeeded: Longint;
  516. BEGIN
  517.     StackNeeded := 0;
  518. END;
  519.  
  520. {$S Initialize}
  521. {-----------------------------------+
  522. |    HeapNeeded                        |
  523. +-----------------------------------}
  524. FUNCTION TApplication.HeapNeeded: Longint;
  525. BEGIN
  526.     HeapNeeded := 0;
  527. END;
  528.  
  529. {$S Main}
  530. {-----------------------------------+
  531. |    SleepVal                        |
  532. +-----------------------------------}
  533. FUNCTION TApplication.SleepVal: LongInt;
  534. BEGIN
  535.     SleepVal := 0;
  536. END;